home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
cpt152.zip
/
CPT-S152.ZIP
/
CPT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-16
|
4KB
|
113 lines
PROGRAM Conference_Participation_Tracker;
{$IFDEF DPMI}
{$M 5120} { reduce stack due to few variables }
{$ELSE}
{$M 5120,0,655360}
{$ENDIF}
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
USES DOS, CPT_CODE;
{$IFDEF DPMI}
CONST progname='CPT-p';
mode='protected mode.';
{$ELSE}
CONST progname='CPT';
mode='real mode.';
{$ENDIF}
VAR
SavedExitProc: POINTER;
{===========================================================================}
PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
BEGIN
ExitProc := SavedExitProc;
cursorOn;
IF (ExitCode > 0) THEN BEGIN
WriteLn (progname+version+'- Free DOS prog: Conference Participation Tracker, '+mode);
WriteLn (author+lf);
WriteLn ('Usage: '+progname+' <QWKfile(s)> <CPT file>'+lf);
WriteLn ('Note: <CPT file> is any DOS filename, with an embedded conference number,');
WriteLn (' and with or without a file extension.'+lf);
WriteLn ('WARNING: Do NOT use a file created by a program other than CPT!'+lf);
WriteLn ('Examples:'+lf);
WriteLn (' '+progname+' \qwks\panasia.qwk 123');
WriteLn (' '+progname+' channel1.qw* cnf_456.mem');
WriteLn (' '+progname+' c:\qwk\lun*.qwk c:\conf\mem_78.dat');
WriteLn (' '+progname+' *.qwk 90'+lf);
END;
IF ErrorAddr <> NIL THEN {If an unanticipated run-time error occured...}
BEGIN
WriteLn ('An unanticipated error occurred, please contact DDA with the following data:');
WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
WriteLn ('Code = ', ExitCode);
ErrorAddr := NIL; {IMPORTANT!!!}
END
ELSE
IF (ExitCode IN [1..254]) THEN
WriteError (ExitCode);
END;
{===========================================================================}
VAR
MemberInfo : MemLink;
OrigMems,
PrevMems,
Members : WORD;
MemFileName : PATHSTR;
QWKpath : PATHSTR; { QWK file path. }
QWKdir : DIRSTR; { QWK file dir. }
dirinfo : SEARCHREC; { contains filespec info. }
BEGIN
SavedExitProc := ExitProc;
ExitProc := @CustomExit;
IF ParamCount <> 2 THEN Halt (255);
MemFileName := GetConfNUMBER (ParamStr (2));
WriteLn (progname, ' - Conference Participation Tracker, ', mode);
WriteLn (progname, version, 'updating ', MemFileName);
Write ('Checking memory available for data ... done!'); WriteMemAvail;
Members := BuildList (MemberInfo, MemFileName); WriteMemAvail;
WriteLn ('There are ',Members, ' participants to begin with.');
OrigMems := Members;
QWKpath := GetFilePath (ParamStr (1), QWKdir);
FindFirst (QWKpath, Archive, dirinfo); IF DosError <> 0 THEN Halt (2);
WHILE DosError = 0 DO
BEGIN
QWKpath := QWKdir + dirinfo. Name;
Write ('Reading ', QWKpath, ' ... ');
EraseFile (DATFileName);
ExCMD := IsArchive (QWKpath);
IF ExtractFile (QWKpath, DATfileName, ExCMD) THEN
BEGIN
IF CONFname = '' THEN
CONFname := GetCONFname (QWKpath, CNFFileName);
PrevMems := Members;
Members := Members + ReadDAT (MemberInfo, DATFileName);
Write ('done!'); WriteMemAvail;
WriteLn ('Added ',Members - PrevMems,' new participant(s) this packet, now there are ',Members,' total.');
EraseFile (DATFileName);
END
ELSE
WriteLn ('no MESSAGES.DAT - skipping.');
FindNext (dirinfo);
END;
IF MemberInfo <> NIL THEN BEGIN
{ GetSortField ('NAME'); }
{ SortLinkedList (MemberInfo); WriteMemAvail; }
WriteList (MemberInfo, MemFileName, Members); WriteMemAvail;
END;
WriteLn ('Added ',Members - OrigMems,' new participant(s) this session, now there are ',Members,' total.');
WriteLn ('Mission accomplished!');
END.